home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
B-Book Series
/
(k)b2.d64
/
wheel
< prev
next >
Wrap
Text File
|
2007-02-28
|
2KB
|
81 lines
0010 //PROGRAM: WHEEL//
0020 //
0030 DIM COLOR$ OF 10, GUESS$ OF 10
0040 DIM ANSW$ OF 3, LEGAL$ OF 30
0050 LEGAL$:=".RED.YELLOW.GREEN.BLUE."
0060 REPEAT
0070 BET
0080 WHEEL
0090 RESULT
0100 UNTIL HALT
0110 //
0120 PROC WHEEL
0130 OUTCOME:=RND(1,15)
0140 CASE OUTCOME OF
0150 WHEN 1,3,6,9,12,15
0160 COLOR$:="RED"
0170 FACTOR:=1.5
0180 WHEN 2,5,8,11,14
0190 COLOR$:="YELLOW"
0200 FACTOR:=2
0210 WHEN 4,10,13
0220 COLOR$:="GREEN"
0230 FACTOR:=3
0240 WHEN 7
0250 COLOR$:="BLUE"
0260 FACTOR:=9
0270 ENDCASE
0280 DISPLAY(COLOR$)
0290 ENDPROC WHEEL
0300 //
0310 PROC BET
0320 WRITEFROM(8)
0330 PRINT "WHAT COLOR",
0340 INPUT GUESS$
0350 WHILE NOT "."+GUESS$+"." IN LEGAL$ DO
0360 WRITEFROM(8)
0370 PRINT "ONLY (RED,YELLOW,GREEN,BLUE) ALLOWED!"
0380 PRINT "NOW, WHAT DO YOU PICK OUT",
0390 INPUT GUESS$
0400 ENDWHILE
0410 WRITEFROM(8)
0420 PRINT "HOW MUCH DO YOU WANT TO BET",
0430 INPUT STAKE
0440 WHILE STAKE<10 DO
0450 WRITEFROM(8)
0460 PRINT "DON'T BE MEAN, MAN!"
0470 PRINT "NOT LESS THAN 10 PENCE."
0480 PRINT "MAY WE ASK FOR YOUR BET",
0490 INPUT STAKE
0500 ENDWHILE
0510 ENDPROC BET
0520 //
0530 PROC RESULT
0540 WRITEFROM(8)
0550 IF GUESS$=COLOR$ THEN
0560 PRINT "HURRAY, YOU WIN!!"
0570 PRINT "YOU HAVE STAKED ",STAKE," PENCE,"
0580 PRINT "SO YOU GET ",STAKE*FACTOR,"PENCE."
0590 ELSE
0600 PRINT "SORRY YOU HAVE LOST ",STAKE," PENCE."
0610 PRINT "BETTER LUCK NEXT TIME."
0620 ENDIF
0630 FOR I:=1 TO 5 DO PRINT // 5 DOWN
0640 INPUT "PLAY AGAIN (Y/N)? ": ANSW$
0650 HALT:=ANSW$="N"
0660 ENDPROC RESULT
0670 //
0680 PROC DISPLAY(C$)
0690 FOR I:=1 TO 5 DO
0700 WRITEFROM(8)
0710 PRINT "******* ",C$," WINS *******"
0720 FOR T:=1 TO 100 DO DUMMY:=0 //WAIT
0730 ENDFOR I
0740 ENDPROC DISPLAY
0750 //
0760 PROC WRITEFROM(LN) CLOSED
0770 PRINT CHR$(147), //CLEAR SCREEN
0780 FOR I:=1 TO LN DO PRINT
0790 ENDPROC WRITEFROM
0800 //